home *** CD-ROM | disk | FTP | other *** search
/ Speccy ClassiX 1998 / Speccy ClassiX 98.iso / amiga_system / the_aminet / dev / e / jrhrkrm2.lzh / Src / Tools / LongReal / longreal.e
Text File  |  1995-09-20  |  10KB  |  520 lines
  1. -> longreal module!
  2.  
  3. OPT MODULE
  4. OPT EXPORT
  5.  
  6. OBJECT longreal
  7.   PRIVATE a,b
  8. ENDOBJECT
  9.  
  10. MODULE 'mathieeedoubbas', 'mathieeedoubtrans'
  11.  
  12. EXPORT DEF mathieeedoubbascount, mathieeedoubtranscount
  13.  
  14. RAISE "DLIB" IF OpenLibrary()=NIL
  15.  
  16. PROC dInit(trans=TRUE)
  17.   IF mathieeedoubbascount=0
  18.     mathieeedoubbasbase:=OpenLibrary('mathieeedoubbas.library',0)
  19.   ENDIF
  20.   mathieeedoubbascount++
  21.   IF trans
  22.     IF mathieeedoubtranscount=0
  23.       mathieeedoubtransbase:=OpenLibrary('mathieeedoubtrans.library',0)
  24.     ENDIF
  25.     mathieeedoubtranscount++
  26.   ENDIF
  27. ENDPROC
  28.  
  29. PROC dCleanup(trans=TRUE)
  30.   IF mathieeedoubbasbase
  31.     IF mathieeedoubbascount--=0 THEN CloseLibrary(mathieeedoubbasbase)
  32.   ENDIF
  33.   IF trans
  34.     IF mathieeedoubtransbase
  35.       IF mathieeedoubtranscount--=0 THEN CloseLibrary(mathieeedoubtransbase)
  36.     ENDIF  
  37.   ENDIF
  38. ENDPROC
  39.  
  40. PROC dFloat(int,longreal:PTR TO longreal)
  41.   DEF a,b
  42.   a,b:=IeeeDPFlt(int)
  43.   longreal.a:=a
  44.   longreal.b:=b
  45. ENDPROC longreal
  46.  
  47. PROC dFix(longreal:PTR TO longreal) IS IeeeDPFix(longreal.a,longreal.b)
  48.  
  49. PROC dTst(x:PTR TO longreal) IS IeeeDPTst(x.a,x.b)
  50.  
  51. PROC dCompare(x:PTR TO longreal,y:PTR TO longreal) IS IeeeDPCmp(x.a,x.b,y.a,y.b)
  52.  
  53. PROC dAdd(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  54.   DEF a,b
  55.   a,b:=IeeeDPAdd(x.a,x.b,y.a,y.b)
  56.   IF to
  57.     to.a:=a; to.b:=b
  58.     RETURN to
  59.   ELSE
  60.     x.a:=a; x.b:=b
  61.   ENDIF
  62. ENDPROC x
  63.  
  64. PROC dSub(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  65.   DEF a,b
  66.   a,b:=IeeeDPSub(x.a,x.b,y.a,y.b)
  67.   IF to
  68.     to.a:=a; to.b:=b
  69.     RETURN to
  70.   ELSE
  71.     x.a:=a; x.b:=b
  72.   ENDIF
  73. ENDPROC x
  74.  
  75. PROC dMul(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  76.   DEF a,b
  77.   a,b:=IeeeDPMul(x.a,x.b,y.a,y.b)
  78.   IF to
  79.     to.a:=a; to.b:=b
  80.     RETURN to
  81.   ELSE
  82.     x.a:=a; x.b:=b
  83.   ENDIF
  84. ENDPROC x
  85.  
  86. PROC dDiv(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  87.   DEF a,b
  88.   a,b:=IeeeDPDiv(x.a,x.b,y.a,y.b)
  89.   IF to
  90.     to.a:=a; to.b:=b
  91.     RETURN to
  92.   ELSE
  93.     x.a:=a; x.b:=b
  94.   ENDIF
  95. ENDPROC x
  96.  
  97. PROC dRound(x:PTR TO longreal)
  98.   DEF a,b
  99.   a,b:=IeeeDPFloor(x.a,x.b)
  100.   x.a:=a; x.b:=b
  101. ENDPROC x
  102.  
  103. PROC dRoundUp(x:PTR TO longreal)
  104.   DEF a,b
  105.   a,b:=IeeeDPCeil(x.a,x.b)
  106.   x.a:=a; x.b:=b
  107. ENDPROC x
  108.  
  109. PROC dNeg(x:PTR TO longreal)
  110.   DEF a,b
  111.   a,b:=IeeeDPNeg(x.a,x.b)
  112.   x.a:=a; x.b:=b
  113. ENDPROC x
  114.  
  115. PROC dAbs(x:PTR TO longreal)
  116.   DEF a,b
  117.   a,b:=IeeeDPAbs(x.a,x.b)
  118.   x.a:=a; x.b:=b
  119. ENDPROC x
  120.  
  121. PROC dCopy(x:PTR TO longreal,y:PTR TO longreal)
  122.   x.a:=y.a
  123.   x.b:=y.b
  124. ENDPROC x
  125.  
  126. /*********************************************************************/
  127. /* Converts a longreal x to ascii in buffer s with num digits        */
  128. /* Only for fraction numbers                                         */
  129. /*                                                                   */
  130. /* PARAM IN    s   - buffer for ascii representation [STRING]        */
  131. /*             x   - longreal to be converted                        */
  132. /*             num - number of digits                                */ 
  133. /* RETURN      s   - buffer for ascii representation [STRING]        */
  134. /* COMMENT     Buffer s must be large enough to contain the string   */
  135. /*********************************************************************/
  136.  
  137. PROC dFormat(s,x,num)
  138.   DEF c:longreal, d:longreal, e, f[1]:ARRAY, fmt
  139.   IF dTst(x)<0
  140.     dNeg(x)
  141.     fmt:='-\d.'
  142.   ELSE
  143.     fmt:='\d.'
  144.   ENDIF
  145.   StringF(s,fmt,dFix(x))
  146.   dCopy(c,x)
  147.   FOR e:=1 TO num
  148.     dCopy(d,c)
  149.     dRound(d)
  150.     dSub(c,d)
  151.     dFloat(10,d)
  152.     dMul(c,d)
  153.     f[]:="0"+Abs(dFix(c))
  154.     StrAdd(s,f,1)
  155.   ENDFOR
  156. ENDPROC s
  157.  
  158. /*********************************************************************/
  159. /* Converts a longreal x to ascii in buffer s with num digits        */
  160. /* Also for 'large' numbers                                          */
  161. /*                                                                   */
  162. /* PARAM IN    s   - buffer for ascii representation [STRING]        */
  163. /*             x   - longreal to be converted                        */
  164. /*             num - number of digits                                */ 
  165. /* RETURN      s   - buffer for ascii representation [STRING]        */
  166. /* COMMENT     Buffer s must be large enough to contain the string   */
  167. /*********************************************************************/
  168.  
  169. PROC dLFormat(s,x:PTR TO longreal,num)
  170.   DEF power,a:longreal
  171.   DEF one:longreal,ten:longreal
  172.   DEF buffer[30]:STRING
  173.   DEF sign
  174.  
  175.   sign:=1
  176.   dDouble(10.0,ten)
  177.   dDouble(1.0,one)
  178.   dCopy(a,x)
  179.   power:=0
  180.   IF dTst(a)=0
  181.     dFormat(s,a,num)
  182.     RETURN s
  183.   ENDIF
  184.   IF (dTst(a)=-1)
  185.     sign:=-1
  186.     dNeg(a)
  187.   ENDIF
  188.   IF dCompare(a,one)=-1
  189.     WHILE dCompare(a,one)=-1
  190.       dMul(a,ten) 
  191.       power--
  192.     ENDWHILE
  193.   ELSE
  194.     WHILE dCompare(a,ten)=1
  195.       dDiv(a,ten) 
  196.       power++
  197.     ENDWHILE
  198.   ENDIF
  199.   dFormat(buffer,a,num)
  200.   IF (sign=1)
  201.     StringF(s,'\sE\d',buffer,power)
  202.   ELSE
  203.     StringF(s,'-\sE\d',buffer,power)
  204.   ENDIF    
  205. ENDPROC s
  206.  
  207. /*********************************************************************/
  208. /* Converts an ascii representation to a longreal                    */
  209. /*                                                                   */
  210. /* PARAM IN    buffer - buffer with longreal in ascii [STRING]       */
  211. /*             x      - converted longreal                           */
  212. /*********************************************************************/
  213.  
  214. PROC a2d(buffer,x:PTR TO longreal)
  215.  DEF divider:longreal
  216.  DEF fraction:longreal
  217.  DEF ten:longreal
  218.  DEF tmp:longreal
  219.  DEF longexp:longreal
  220.  
  221.  DEF i,exp,expsign,sign
  222.  
  223.  DEF tmpbuffer[256]:STRING
  224.  
  225.  dFloat(0,x)
  226.  dFloat(10,ten)
  227.  i:=0
  228.  sign:=1
  229.  IF buffer[i]="-"
  230.    sign:=-1
  231.    i++
  232.  ELSE
  233.    IF buffer[i]="+" THEN i++
  234.  ENDIF
  235.  
  236.  WHILE ((buffer[i]>="0") AND (buffer[i]<="9") AND (buffer[i]<>0))  
  237.   dFloat(buffer[i]-"0",tmp)
  238.   dMul(x,ten)
  239.   dAdd(x,tmp)
  240.   i++
  241.  ENDWHILE
  242.  
  243.  
  244.  IF (buffer[i]="." AND (buffer[i+1]>="0") AND (buffer[i+1]<="9"))
  245.    i++
  246.    dFloat(1,divider)
  247.    dFloat(0,fraction)
  248.    WHILE ((buffer[i]>="0") AND (buffer[i]<="9") AND (buffer[i]<>0))  
  249.     dMul(fraction,ten)
  250.     dFloat(buffer[i]-"0",tmp)
  251.     dAdd(fraction,tmp)
  252.     dMul(divider,ten)
  253.     i++
  254.    ENDWHILE
  255.    dDiv(fraction,divider)
  256.    dAdd(x,fraction)
  257.   ENDIF
  258.   dFloat(sign,tmp)
  259.   dMul(x,tmp)
  260.  
  261.   IF ((buffer[i]="E") OR (buffer[i]="e"))
  262.     i++
  263.     IF buffer[i]="-"
  264.       expsign:=-1
  265.       i++
  266.     ELSE
  267.       expsign:=1
  268.       IF (buffer[i]="+") THEN i++
  269.     ENDIF  
  270.     exp:=0
  271.     WHILE ((buffer[i]>="0") AND (buffer[i]<="9") AND (buffer[i]<>0))  
  272.       exp:=Mul(exp,10)+buffer[i]-"0"
  273.       i++
  274.     ENDWHILE
  275.     dFloat(exp*expsign,longexp)
  276.     dPow(ten,longexp)
  277.     dMul(x,ten)
  278.   ENDIF
  279. ENDPROC
  280.  
  281.  
  282. /* Converts an IEEE single to a longreal */
  283.  
  284. PROC dDouble(x,to:PTR TO longreal)
  285.   DEF a,b
  286.   a,b:=IeeeDPFieee(x)
  287.   to.a:=a
  288.   to.b:=b
  289. ENDPROC
  290.  
  291.  
  292. /* Converts a longreal to an IEEE single */
  293.  
  294. PROC dSingle(x:PTR TO longreal) IS IeeeDPTieee(x.a,x.b)
  295.   
  296.  
  297. PROC dSqrt(x:PTR TO longreal)
  298.   DEF a,b
  299.   a,b:=IeeeDPSqrt(x.a,x.b)
  300.   x.a:=a; x.b:=b
  301. ENDPROC
  302.  
  303.  
  304. /* Return longreal PI in x */
  305.  
  306. PROC dPi(x:PTR TO longreal)
  307.  x.a:=$400921FB            /* Dirty but quick 8-) */
  308.  x.b:=$54442D18
  309. ENDPROC x
  310.  
  311. /* Converts x from degrees to radians */
  312.  
  313. PROC dRad(x:PTR TO longreal,to=NIL:PTR TO longreal)
  314.   DEF s:longreal,t:longreal
  315.    
  316.   dPi(t)
  317.   dDouble(180.0,s)
  318.  
  319.   dDiv(t,s)
  320.   dMul(t,x)
  321.   IF to
  322.     to.a:=t.a
  323.     to.b:=t.b
  324.     RETURN to
  325.   ELSE
  326.     x.a:=t.a
  327.     x.b:=t.b
  328.     RETURN x
  329.   ENDIF
  330. ENDPROC
  331.  
  332. PROC dSin(x:PTR TO longreal,to=NIL:PTR TO longreal)
  333.   DEF a,b
  334.   a,b:=IeeeDPSin(x.a,x.b)
  335.   IF to
  336.     to.a:=a
  337.     to.b:=b
  338.     RETURN to
  339.   ELSE
  340.     x.a:=a
  341.     x.b:=b
  342.     RETURN x
  343.   ENDIF
  344. ENDPROC
  345.  
  346. PROC dCos(x:PTR TO longreal,to=NIL:PTR TO longreal)
  347.   DEF a,b
  348.   a,b:=IeeeDPCos(x.a,x.b)
  349.   IF to
  350.     to.a:=a
  351.     to.b:=b
  352.     RETURN to
  353.   ELSE
  354.     x.a:=a
  355.     x.b:=b
  356.     RETURN x
  357.   ENDIF
  358. ENDPROC
  359.  
  360. PROC dTan(x:PTR TO longreal,to=NIL:PTR TO longreal)
  361.   DEF a,b
  362.   a,b:=IeeeDPTan(x.a,x.b)
  363.   IF to
  364.     to.a:=a
  365.     to.b:=b
  366.     RETURN to
  367.   ELSE
  368.     x.a:=a
  369.     x.b:=b
  370.     RETURN x
  371.   ENDIF
  372. ENDPROC
  373.  
  374. PROC dASin(x:PTR TO longreal,to=NIL:PTR TO longreal)
  375.   DEF a,b
  376.   a,b:=IeeeDPAsin(x.a,x.b)
  377.   IF to
  378.     to.a:=a
  379.     to.b:=b
  380.     RETURN to
  381.   ELSE
  382.     x.a:=a
  383.     x.b:=b
  384.     RETURN x
  385.   ENDIF
  386. ENDPROC
  387.  
  388.  
  389. PROC dACos(x:PTR TO longreal,to=NIL:PTR TO longreal)
  390.   DEF a,b
  391.   a,b:=IeeeDPAcos(x.a,x.b)
  392.   IF to
  393.     to.a:=a
  394.     to.b:=b
  395.     RETURN to
  396.   ELSE
  397.     x.a:=a
  398.     x.b:=b
  399.     RETURN x
  400.   ENDIF
  401. ENDPROC
  402.  
  403.  
  404. PROC dATan(x:PTR TO longreal,to=NIL:PTR TO longreal)
  405.   DEF a,b
  406.   a,b:=IeeeDPAtan(x.a,x.b)
  407.   IF to
  408.     to.a:=a
  409.     to.b:=b
  410.     RETURN to
  411.   ELSE
  412.     x.a:=a
  413.     x.b:=b
  414.     RETURN x
  415.   ENDIF
  416. ENDPROC
  417.  
  418. PROC dSinh(x:PTR TO longreal,to=NIL:PTR TO longreal)
  419.   DEF a,b
  420.   a,b:=IeeeDPSinh(x.a,x.b)
  421.   IF to
  422.     to.a:=a
  423.     to.b:=b
  424.     RETURN to
  425.   ELSE
  426.     x.a:=a
  427.     x.b:=b
  428.     RETURN x
  429.   ENDIF
  430. ENDPROC
  431.  
  432. PROC dCosh(x:PTR TO longreal,to=NIL:PTR TO longreal)
  433.   DEF a,b
  434.   a,b:=IeeeDPCosh(x.a,x.b)
  435.   IF to
  436.     to.a:=a
  437.     to.b:=b
  438.     RETURN to
  439.   ELSE
  440.     x.a:=a
  441.     x.b:=b
  442.     RETURN x
  443.   ENDIF
  444. ENDPROC
  445.  
  446. PROC dTanh(x:PTR TO longreal,to=NIL:PTR TO longreal)
  447.   DEF a,b
  448.   a,b:=IeeeDPTanh(x.a,x.b)
  449.   IF to
  450.     to.a:=a
  451.     to.b:=b
  452.     RETURN to
  453.   ELSE
  454.     x.a:=a
  455.     x.b:=b
  456.     RETURN x
  457.   ENDIF
  458. ENDPROC
  459.  
  460.  
  461. PROC dExp(x:PTR TO longreal,to=NIL:PTR TO longreal)
  462.   DEF a,b
  463.   a,b:=IeeeDPExp(x.a,x.b)
  464.   IF to
  465.     to.a:=a
  466.     to.b:=b
  467.     RETURN to
  468.   ELSE
  469.     x.a:=a
  470.     x.b:=b
  471.     RETURN x
  472.   ENDIF
  473. ENDPROC
  474.  
  475. PROC dLn(x:PTR TO longreal,to=NIL:PTR TO longreal)
  476.   DEF a,b
  477.   a,b:=IeeeDPLog(x.a,x.b)
  478.   IF to
  479.     to.a:=a
  480.     to.b:=b
  481.     RETURN to
  482.   ELSE
  483.     x.a:=a
  484.     x.b:=b
  485.     RETURN x
  486.   ENDIF
  487. ENDPROC
  488.  
  489. PROC dLog(x:PTR TO longreal,to=NIL:PTR TO longreal)
  490.   DEF a,b
  491.   a,b:=IeeeDPLog10(x.a,x.b)
  492.   IF to
  493.     to.a:=a
  494.     to.b:=b
  495.     RETURN to
  496.   ELSE
  497.     x.a:=a
  498.     x.b:=b
  499.     RETURN x
  500.   ENDIF
  501. ENDPROC
  502.  
  503. /* Calculates x^y */
  504.  
  505. PROC dPow(x:PTR TO longreal,y:PTR TO longreal,to=NIL:PTR TO longreal)
  506.   DEF a,b
  507.   a,b:=IeeeDPPow(y.a,y.b,x.a,x.b)
  508.   IF to
  509.     to.a:=a
  510.     to.b:=b
  511.     RETURN to
  512.   ELSE
  513.     x.a:=a
  514.     x.b:=b
  515.     RETURN x
  516.   ENDIF
  517. ENDPROC
  518.  
  519.  
  520.